The following pages contain listings of three reusable component specifications in Ada from the CSPARTS collection. These specifications are: CONSOLE -- an abstract state machine which provides an interface to the user's console DLIST -- a class definition which defines a doubly-linked list class of objects TOD -- a collection of utility routines for converting between various time of day representations to Ada's CALENDAR.TIME format -- ********************************************************* -- * * -- * Console * SPEC -- * * -- ********************************************************* package Console is --| Purpose --| Console provides a set of I/O and screen control commands --| for either IBM PC computers employing the ANSI.SYS device --| driver or the VT100-compatible family of terminals. By using --| this package, a programmer may manipulate the terminal screen --| regardless if it is an IBM PC with ANSI.SYS or a VT100 terminal. --| --| The console object runs in one of three modes: --| TTY All screen-oriented commands are disabled --| VT100 All screen-oriented commands except display --| color control (foreground and background) --| are enabled --| ANSI All screen-oriented commands are enabled --| The default mode is TTY, and the mode of the console object --| can be changed at any time by calling the Set_Terminal --| routine. --| --| The output to the console object can be enabled or disabled --| by using the Enable_Output and Disable_Output routines. --| The Push and Pop routines can be used to preserve the current --| state of the console and restore the console to the previous --| state. --| --| Initialization Exceptions (none) --| Notes (none) --| --| Modifications --| 3/8/91 Richard Conn Initial Release Max_Number_of_States : constant NATURAL := 10; -- number of enable/disable states to the console; also, -- number of Push calls before a State_Overflow exception type TERMINAL_KIND is (TTY, -- no screen-oriented commands ANSI, -- colors supported VT100 -- no colors ); type ROW_NUMBER is new INTEGER range 1..24; type COLUMN_NUMBER is new INTEGER range 1..80; type RENDITION is (ALL_ATTRIBUTES_OFF, -- ANSI.SYS or VT100 HIGH_INTENSITY, BLINKING, REVERSE_VIDEO, FOREGROUND_BLACK, -- ANSI.SYS only FOREGROUND_RED, FOREGROUND_GREEN, FOREGROUND_YELLOW, FOREGROUND_BLUE, FOREGROUND_MAGENTA, FOREGROUND_CYAN, FOREGROUND_WHITE, BACKGROUND_BLACK, BACKGROUND_RED, BACKGROUND_GREEN, BACKGROUND_YELLOW, BACKGROUND_BLUE, BACKGROUND_MAGENTA, BACKGROUND_CYAN, BACKGROUND_WHITE); for RENDITION'Size use INTEGER'Size; for RENDITION use (ALL_ATTRIBUTES_OFF => 0, -- ANSI.SYS or VT100 HIGH_INTENSITY => 1, BLINKING => 5, REVERSE_VIDEO => 7, FOREGROUND_BLACK => 30, -- ANSI.SYS only FOREGROUND_RED => 31, FOREGROUND_GREEN => 32, FOREGROUND_YELLOW => 33, FOREGROUND_BLUE => 34, FOREGROUND_MAGENTA => 35, FOREGROUND_CYAN => 36, FOREGROUND_WHITE => 37, BACKGROUND_BLACK => 40, BACKGROUND_RED => 41, BACKGROUND_GREEN => 42, BACKGROUND_YELLOW => 43, BACKGROUND_BLUE => 44, BACKGROUND_MAGENTA => 45, BACKGROUND_CYAN => 46, BACKGROUND_WHITE => 47); type OVERFLOW_ACTION is -- used for a Put(STRING) (TRUNCATE_HEAD, -- ABC becomes "BC" TRUNCATE_TAIL, -- ABC becomes "AB" FILL_WITH_OVERFLOW_CHAR -- ABC becomes "**" ); type NUMERIC_OVERFLOW_ACTION is -- used for a Put(INTEGER) (FILL_WITH_OVERFLOW_CHAR, -- 123 becomes "**" OUTPUT_FULL_NUMBER -- 123 becomes "123" ); type JUSTIFICATION is -- used for a Put(STRING) (LEFT_JUSTIFIED, -- ABC becomes "ABC " RIGHT_JUSTIFIED -- ABC becomes " ABC" ); INPUT_ERROR : exception; -- raised on invalid input STATE_OVERFLOW : exception; -- raised if the Max_Number_of_States is exceeded STATE_UNDERFLOW : exception; -- raised if too many Pop routine calls are made -- .............................................................. -- . . -- . Console.Set_Terminal . SPEC -- . . -- .............................................................. procedure Set_Terminal (New_Setting : in TERMINAL_KIND := TTY); --| Purpose --| Define the kind of user's terminal. If this routine is not --| called, TTY is assumed. --| --| Exceptions (none) --| Notes (none) -- .............................................................. -- . . -- . Console.Enable_Output . SPEC -- . . -- .............................................................. procedure Enable_Output; --| Purpose --| Enable the output routines of the console object (affects current --| state only). These routines include Position_Cursor, Erase_Display, --| Erase_Line, Set_Rendition, all the Put and Put_Line routines, and --| New_Line. --| --| Exceptions (none) --| Notes (none) -- .............................................................. -- . . -- . Console.Disable_Output . SPEC -- . . -- .............................................................. procedure Disable_Output; --| Purpose --| Disable the output routines of the console object (affects current --| state only). These routines include Position_Cursor, Erase_Display, --| Erase_Line, Set_Rendition, all the Put and Put_Line routines, and --| New_Line. --| --| Exceptions (none) --| Notes (none) -- .............................................................. -- . . -- . Console.Push . SPEC -- . . -- .............................................................. procedure Push; --| Purpose --| Increment to the next state (environment) of the console object. --| All states are initialized to be enabled. This routine permits, --| for example, a console to be turned off for silent running and --| then temporarily turned on for an error message display. The --| console object stays in this new state, which may be altered by --| the Enable_Output and Disable_Output routines, until a Pop is --| executed. --| --| Exceptions --| STATE_OVERFLOW -- raised if Max_Number_of_States is exceeded --| Notes (none) -- .............................................................. -- . . -- . Console.Pop . SPEC -- . . -- .............................................................. procedure Pop; --| Purpose --| Decrement to the previous state (environment) of the console object. --| All states are initialized to be enabled. See the Push routine --| for more details. --| --| Exceptions --| STATE_UNDERFLOW -- raised if current state tries to drop below 0 --| Notes (none) -- .............................................................. -- . . -- . Console.Position_Cursor . SPEC -- . . -- .............................................................. procedure Position_Cursor (Row : in ROW_NUMBER; Column : in COLUMN_NUMBER); --| Purpose --| Position the cursor to the indicated Row and Column. Row 1, --| Column 1 is the upper left corner of the screen. --| --| Exceptions (none) --| Notes (none) -- .............................................................. -- . . -- . Console.Erase_Display . SPEC -- . . -- .............................................................. procedure Erase_Display; --| Purpose --| Erase the entire display and place the cursor at the home position. --| --| Exceptions (none) --| Notes (none) -- .............................................................. -- . . -- . Console.Erase_Line . SPEC -- . . -- .............................................................. procedure Erase_Line; --| Purpose --| Erase from the cursor to the end of the line. --| --| Exceptions (none) --| Notes (none) -- .............................................................. -- . . -- . Console.Set_Rendition . SPEC -- . . -- .............................................................. procedure Set_Rendition (New_Setting : in RENDITION); --| Purpose --| Add the indicated New_Setting to the current graphics display --| rendition (default is ALL_ATTRIBUTES_OFF). Calls to this procedure --| are cumulative until all attributes are turned off. --| --| Exceptions (none) --| --| Notes --| Color selections are ignored on a VT100 compatible terminal. -- .............................................................. -- . . -- . Console.Put . SPEC -- . . -- .............................................................. procedure Put (Item : in CHARACTER); procedure Put (Item : in STRING); --| Purpose --| Output a character or a string to the console. --| --| Exceptions (none) --| Notes (none) -- .............................................................. -- . . -- . Console.Put . SPEC -- . . -- .............................................................. procedure Put ( Item : in STRING; Field_Width : in NATURAL; On_Overflow : in OVERFLOW_ACTION := TRUNCATE_TAIL; On_Underflow : in JUSTIFICATION := LEFT_JUSTIFIED; Fill_Char : in CHARACTER := ' '; Overflow_Char : in CHARACTER := '*' ); --| Purpose --| Output a string to the console in a field of a given --| Field_Width. --| If Item is shorter than Field_Width, --| the On_Underflow flag takes effect, justifying Item --| in the field as indicated using the Fill_Char. --| If Item is longer than Field_Width, the On_Overflow --| flag takes effect, either truncating Item on the left or --| right or filling the field with the Overflow_Char. --| --| Exceptions (none) --| Notes (none) -- .............................................................. -- . . -- . Console.Put . SPEC -- . . -- .............................................................. procedure Put (Item : in INTEGER; Width : in NATURAL; On_Overflow : in NUMERIC_OVERFLOW_ACTION := FILL_WITH_OVERFLOW_CHAR; Overflow_Char : in CHARACTER := '*'); --| Purpose --| Output an integer to the console. It will be placed in a --| field that is Width characters long. Width of 0 fits the --| INTEGER exactly. If the resulting sequence of characters --| has fewer than Width characters, then leading spaces are --| first output to make up the difference. If the resulting --| sequence of characters has more than Width characters, --| then the On_Overflow flag takes effect. --| --| Exceptions (none) --| Notes (none) -- .............................................................. -- . . -- . Console.Put . SPEC -- . . -- .............................................................. procedure Put (Item : in FLOAT; Fore : in NATURAL; Aft : in NATURAL; On_Overflow : in NUMERIC_OVERFLOW_ACTION := FILL_WITH_OVERFLOW_CHAR; Overflow_Char : in CHARACTER := '*'); --| Purpose --| Output a floating point number to the console. Fore is the --| number of characters to be displayed before the decimal point, --| and Aft is the number of characters to be displayed after the --| decimal point. Item's value appears as follows: --| --| Fore Aft fields --| ---- --- (Fore=4, Aft=3) --| nnnn.nnn if Item is positive --| -nnn.nnn if Item is negative --| ******** if overflow with defaults --| --| If Item is negative, a leading minus sign, which counts as --| one of the characters in the Fore field, is output. --| If -1.0 < Item < 1.0, then -0 or 0 is output in the Fore --| field. --| If the number of digits required to display Item in the Fore --| field exceeds the value of Fore (i.e., is too big), the --| On_Overflow flag takes effect, either overriding Fore or filling --| the field with the Overflow_Char. --| --| Exceptions (none) --| Notes (none) -- .............................................................. -- . . -- . Console.Put . SPEC -- . . -- .............................................................. procedure Put (Item : in FLOAT; Fore : in NATURAL := 2; Aft : in NATURAL := 2; Exp : in NATURAL := 3); --| Purpose --| Output a floating point number in scientific notation --| to the console. Fore is the number of characters to be --| displayed before the decimal point (only one digit and --| a sign are displayed, so rest of Fore characters are --| leading spaces), Aft is the number of characters to be --| displayed after the decimal point, and Exp is the number --| of characters in the exponent. Item's value appears as: --| --| -- ---- --- (Fore=2, Aft=4, Exp=3) --| n.nnnnE+nn if Item is positive --| -n.nnnnE+nn if Item is negative --| --| The Fore field will always contain a single digit with --| an optional minus sign. If Fore > 2, leading spaces are --| prefixed to the output. Hence, Put(-123.0, 4, 2, 3) outputs --| " -1.23E+02". --| Exp is the size of the field for the number after the "E". --| This field always includes a leading sign (see -123.0 example --| above). --| --| Exceptions (none) --| Notes (none) -- .............................................................. -- . . -- . Console.Put_Line . SPEC -- . . -- .............................................................. procedure Put_Line (Item : in STRING); --| Purpose --| Output a string followed by a new line to the console. --| --| Exceptions (none) --| Notes (none) -- .............................................................. -- . . -- . Console.New_Line . SPEC -- . . -- .............................................................. procedure New_Line; --| Purpose --| Output a new line to the console. --| --| Exceptions (none) --| Notes (none) -- .............................................................. -- . . -- . Console.Get . SPEC -- . . -- .............................................................. procedure Get ( Item : out CHARACTER); procedure Get ( Item : out INTEGER); procedure Get ( Item : out FLOAT); --| Purpose --| Get views the Console input as a stream and --| returns the next Item of the appropriate type --| from it. --| --| Exceptions --| Input_Error raised if the next item --| in the stream is not of the --| correct type when translated --| from the characters or if the --| translation process encounters --| an error condition --| --| Notes --| If the Item is of type INTEGER or FLOAT, Get --| skips over whitespace characters (blank, tab, new --| line) first and then starts translating at the --| first non-white character encountered. --| If the Item is of type CHARACTER, Get returns --| the next character, whitespace or not. -- .............................................................. -- . . -- . Console.Get_Line . SPEC -- . . -- .............................................................. procedure Get_Line ( Item : out STRING; Last : out NATURAL ); --| Purpose --| Get_Line reads a line from the console. --| --| Exceptions (none) --| Notes (none) end Console; -- ********************************************************** -- * * -- * DOUBLY_LINKED_LIST * SPEC -- * * -- ********************************************************** generic type ELEMENT_OBJECT is private; package Doubly_Linked_List is --| Purpose --| DOUBLY_LINKED_LIST manipulates the abstract data type --| LIST_ID, which is a linked list of objects. --| DOUBLE_LIST provides routines to add objects to, --| delete objects from, and extract objects from --| the list. DOUBLE_LIST also allows the user to --| move about through the list and manipulate the --| list in various ways. --| --| Initialization Exceptions (none) --| --| Notes --| The number of list elements is restricted to --| INTEGER'LAST and the amount of memory or virtual --| memory in the computer system. --| --| Modifications --| Author: Richard Conn -- Types type ELEMENT_POSITION is new INTEGER range 0 .. INTEGER'LAST; type LIST_ID is limited private; -- Exceptions ADVANCE_PAST_END_OF_LIST : exception; BACKUP_BEFORE_BEGINNING_OF_LIST : exception; DYNAMIC_MEMORY_ALLOCATION_PROBLEM : exception; LIST_IS_EMPTY : exception; INVALID_INDEX : exception; UNEXPECTED_ERROR : exception; -- raised anytime -- ........................................................ -- . . -- . DOUBLY_LINKED_LIST.INITIALIZE . SPEC -- . . -- ........................................................ procedure Initialize (ID : in out LIST_ID); --| Purpose --| Initialize the list to empty (the list is empty when --| first used); if the list contained any elements, they --| are deleted. --| --| Exceptions (none) --| Notes (none) -- ........................................................ -- . . -- . DOUBLY_LINKED_LIST.FIRST_ELEMENT . SPEC -- . . -- ........................................................ function First_Element (ID : in LIST_ID) return ELEMENT_OBJECT; --| Purpose --| Return the first element of the list. --| --| Exceptions --| LIST_IS_EMPTY --| --| Notes (none) -- ........................................................ -- . . -- . DOUBLY_LINKED_LIST.LAST_ELEMENT . SPEC -- . . -- ........................................................ function Last_Element (ID : in LIST_ID) return ELEMENT_OBJECT; --| Purpose --| Return the last element of the list. --| --| Exceptions --| LIST_IS_EMPTY --| --| Notes (none) -- ........................................................ -- . . -- . DOUBLY_LINKED_LIST.CURRENT_ELEMENT . SPEC -- . . -- ........................................................ function Current_Element (ID : in LIST_ID) return ELEMENT_OBJECT; --| Purpose --| Return the current element of the list. --| --| Exceptions --| LIST_IS_EMPTY --| --| Notes (none) -- ........................................................ -- . . -- . DOUBLY_LINKED_LIST.GOTO_FIRST . SPEC -- . . -- ........................................................ procedure Goto_First (ID : in out LIST_ID); --| Purpose --| Set the current element of the list to be the first --| element. --| --| Exceptions --| LIST_IS_EMPTY --| --| Notes (none) -- ........................................................ -- . . -- . DOUBLY_LINKED_LIST.GOTO_LAST . SPEC -- . . -- ........................................................ procedure Goto_Last (ID : in out LIST_ID); --| Purpose --| Set the current element of the list to be the last --| element. --| --| Exceptions --| LIST_IS_EMPTY --| --| Notes (none) -- ........................................................ -- . . -- . DOUBLY_LINKED_LIST.GOTO_ELEMENT . SPEC -- . . -- ........................................................ procedure Goto_Element (ID : in out LIST_ID; Index : in ELEMENT_POSITION); --| Purpose --| Set the current element of the list to be the Nth (INDEX) --| element. --| --| Exceptions --| INVALID_INDEX --| LIST_IS_EMPTY --| --| Notes (none) -- ........................................................ -- . . -- . DOUBLY_LINKED_LIST.CURRENT_INDEX . SPEC -- . . -- ........................................................ function Current_Index (ID : in LIST_ID) return ELEMENT_POSITION; --| Purpose --| Return the number of the current element. --| --| Exceptions --| LIST_IS_EMPTY --| --| Notes (none) -- ........................................................ -- . . -- . DOUBLY_LINKED_LIST.LAST_INDEX . SPEC -- . . -- ........................................................ function Last_Index (ID : in LIST_ID) return ELEMENT_POSITION; --| Purpose --| Return the number of the last element. --| --| Exceptions --| LIST_IS_EMPTY --| --| Notes (none) -- ........................................................ -- . . -- . DOUBLY_LINKED_LIST.ADVANCE . SPEC -- . . -- ........................................................ procedure Advance (ID : in out LIST_ID); --| Purpose --| Advance, setting the current element to be the next --| element. --| --| Exceptions --| ADVANCE_PAST_END_OF_LIST --| LIST_IS_EMPTY --| --| Notes (none) -- ........................................................ -- . . -- . DOUBLY_LINKED_LIST.BACKUP . SPEC -- . . -- ........................................................ procedure Backup (ID : in out LIST_ID); --| Purpose --| Backup, setting the current element to be the previous --| element. --| --| Exceptions --| BACKUP_BEFORE_BEGINNING_OF_LIST --| LIST_IS_EMPTY --| --| Notes (none) -- ........................................................ -- . . -- . DOUBLY_LINKED_LIST.IS_EMPTY . SPEC -- . . -- ........................................................ function Is_Empty (ID : in LIST_ID) return BOOLEAN; --| Purpose --| Return TRUE if the list is empty. --| --| Exceptions (none) --| Notes (none) -- ........................................................ -- . . -- . DOUBLY_LINKED_LIST.IS_END . SPEC -- . . -- ........................................................ function Is_End (ID : in LIST_ID) return BOOLEAN; --| Purpose --| Return TRUE if the end of the list has been passed. --| --| Exceptions (none) --| Notes (none) -- ........................................................ -- . . -- . DOUBLY_LINKED_LIST.IS_FIRST . SPEC -- . . -- ........................................................ function Is_First (ID : in LIST_ID) return BOOLEAN; --| Purpose --| Return TRUE if the current element is the first element. --| --| Exceptions (none) --| Notes (none) -- ........................................................ -- . . -- . DOUBLY_LINKED_LIST.APPEND_ELEMENT . SPEC -- . . -- ........................................................ procedure Append_Element (ID : in out LIST_ID; Element : ELEMENT_OBJECT); --| Purpose --| Append an element after the current element; set the current --| element to this new element. --| --| Exceptions --| DYNAMIC_MEMORY_ALLOCATION_PROBLEM --| --| Notes (none) -- ........................................................ -- . . -- . DOUBLY_LINKED_LIST.INSERT_ELEMENT . SPEC -- . . -- ........................................................ procedure Insert_Element (ID : in out LIST_ID; Element : ELEMENT_OBJECT); --| Purpose --| Insert an element before the current element; the current --| element remains unchanged. --| --| Exceptions --| DYNAMIC_MEMORY_ALLOCATION_PROBLEM --| --| Notes (none) -- ........................................................ -- . . -- . DOUBLY_LINKED_LIST.DELETE_ELEMENT . SPEC -- . . -- ........................................................ procedure Delete_Element (ID : in out LIST_ID); --| Purpose --| Delete the current element; the current element becomes the --| element following the current element. --| --| Exceptions --| ADVANCE_PAST_END_OF_LIST --| LIST_IS_EMPTY --| --| Notes (none) private type ELEMENT; type ELEMENT_POINTER is access ELEMENT; type ELEMENT is record Content : ELEMENT_OBJECT; Next : ELEMENT_POINTER; Previous : ELEMENT_POINTER; end record; type LIST_ID is record First : ELEMENT_POINTER := null; -- first element Last : ELEMENT_POINTER := null; -- last element Current : ELEMENT_POINTER := null; -- current element Free : ELEMENT_POINTER := null; -- free element list Number_of_Elements : ELEMENT_POSITION := 0; -- number of elements Current_Index : ELEMENT_POSITION := 0; -- index of current element end record; end Doubly_Linked_List; -- **************************************************** -- * * -- * TOD_UTILITIES * SPEC -- * * -- **************************************************** with Calendar; -- Predefined (internal representation) TOD package. package TOD_Utilities is --| Purpose --| This package will provide direct conversion from an external --| time/date string to the internal Ada CALENDAR.TIME representation --| and vice versa. Most free format external representations are --| supported. Components of an external format include: --| Year, Month and Day (as numbers and strings), Hour, Minutes, --| and Seconds --| As long as the external representation can be parsed unambiguously, --| this package should be able to handle the conversion. Examples of --| legal external formats: --| 7pm Fr March 12, 1982 --| 15 Dec. 84 12:36PM --| YESTERDAY 3PM --| 6/01/83 <-- defaults to 12:00:00AM --| 3:45AM <-- defaults to the current date --| 18:07:35 <-- defaults to the current date --| 8-26 <-- defaults to 12:00:00AM of the current year --| friday <-- defaults to 12:00:00AM of the current or next --| future Friday --| Examples of illegal external representations: --| 2/31/84 <-- February never has a 31st day --| 12:3605/01/84 <-- too tough to parse (nondeterminstic) --| 3/8423:00:00 <-- too tough to parse (nondeterminstic) --| 3:54:29AMTues <-- too tough to parse (nondeterminstic) --| Nov 1983 <-- must always include day number in the date --| Sun 8/3/84 <-- 8/3/84 was a Friday --| --| Optional periods may be placed after ABBREVIATED day/month names. --| --| All external formats are converted to upper case, so there are no --| problems with specifying mixed and/or lower case input. All --| results are returned in upper case by default (which can be overridden --| by specifying lower case or mixed case). --| --| Special external formats: TODAY, TOMORROW, YESTERDAY, NOW --| TODAY is equivalent to 12AM of the current date. TOMORROW and --| YESTERDAY are equivalent to the next/previous date. NOW is --| equivalent to calling the function CALENDAR.CLOCK. --| --| Defaults: --| If the year is omitted, it defaults to the current year. If the --| time is omitted, it defaults to 12:00:00AM. If the day name and no --| date is specified, the current or next future date is assumed. If --| only the time is specified, the current date is assumed. If the --| minutes and/or seconds are not specified in the time, they default --| to zero. If the year is given in short format (1 or 2 digits) then --| it defaults to the current century. --| --| BNF for the external representation: --| { [